home *** CD-ROM | disk | FTP | other *** search
/ Language/OS - Multiplatform Resource Library / LANGUAGE OS.iso / lisp / wcl-21.lha / wcl-2.1 / include / lisp.h
C/C++ Source or Header  |  1992-09-10  |  19KB  |  585 lines
  1. /*  (C) Copyright 1990-1992 by Wade L. Hennessey. All rights reserved. */
  2.  
  3. #define sun4
  4.  
  5. /*#define ansi_varargs */
  6. /*#define ansi_fixed_args */
  7.  
  8. #ifdef sun4
  9. #define SPARC
  10. #define BIG_ENDIAN
  11. #endif
  12.  
  13. #ifdef decstation
  14. #define MIPS
  15. #define LITTLE_ENDIAN
  16. #endif
  17.  
  18. #ifdef __STDC__
  19. /* Put this back when we can get a clean compile again */
  20. /* #define PROTO(args) args */
  21. #define PROTO(args) () 
  22. #else
  23. #define PROTO(args) ()
  24. #endif
  25.  
  26. #ifdef ansi_varargs
  27. /* HEY! .../gcc-include/varargs.h ? */
  28. #include <stdarg.h>
  29. #else
  30. #include <varargs.h>
  31. #endif
  32.  
  33. /* 
  34. TAG byte layout:
  35.  
  36. bit7  bit6   bit5   bit4  bit3   bit2         bit1        bit0
  37. -------------------------------------------------------------------
  38. fillp <array element type....>   0: simple    0: vector   0: array
  39.                                  1: complex   1: multi
  40.  
  41. deref <bignum, ratio tags>       0: rational  0: number   1: other
  42.       <float, complex tags>      1: other-num
  43.  
  44. deref <real, line symbol tags>   0: symbol    1: other    1: other
  45. deref <enum other type.... >     1: other
  46. */
  47.  
  48. #define ARRAY_TAG                                      0x0
  49. #define OTHER_TAG                                      0x1
  50. #define VECTOR_TAG                                     0x0
  51. #define MULTI_ARRAY_TAG                                0x2
  52. #define NUMBER_TAG                                     0x1
  53. #define TAG_MASK                                       0x7f
  54.  
  55. #define VECTOR_TAG_MASK                                0x3
  56. #define NUMBER_TAG_MASK                                0x3
  57.  
  58. #define VECTOR_MASK                                    0x7B
  59. #define ARRAY_MASK                                     0x79
  60.  
  61. #define SIMPLE_VECTOR_TAG                              0x0
  62. #define SIMPLE_MULTI_ARRAY_TAG                         0x2
  63. #define COMPLEX_VECTOR_TAG                             0x4        
  64. #define COMPLEX_MULTI_ARRAY_TAG                        0x6
  65.  
  66. #define ARRAY_ELEMENT_TYPE_MASK                        0x78
  67. #define ELEMENT_TYPE_BIT                               0x00
  68. #define ELEMENT_TYPE_SIGNED_8BIT                       0x08
  69. #define ELEMENT_TYPE_UNSIGNED_8BIT                     0x10
  70. #define ELEMENT_TYPE_CHAR                              0x18
  71. #define ELEMENT_TYPE_SIGNED_16BIT                      0x20
  72. #define ELEMENT_TYPE_UNSIGNED_16BIT                    0x28
  73. #define ELEMENT_TYPE_SIGNED_32BIT                      0x30
  74. #define ELEMENT_TYPE_UNSIGNED_32BIT                    0x38
  75. #define ELEMENT_TYPE_PTR                               0x40
  76. #define ELEMENT_TYPE_FLOAT                             0x48
  77.  
  78. #define TYPE_SIMPLE_BIT_VECTOR                         0x00
  79. #define TYPE_SIMPLE_SIGNED_8BIT_VECTOR                 0x08
  80. #define TYPE_SIMPLE_UNSIGNED_8BIT_VECTOR               0x10
  81. #define TYPE_SIMPLE_STRING                             0x18
  82. #define TYPE_SIMPLE_SIGNED_16BIT_VECTOR                0x20
  83. #define TYPE_SIMPLE_UNSIGNED_16BIT_VECTOR              0x28
  84. #define TYPE_SIMPLE_SIGNED_32BIT_VECTOR                0x30
  85. #define TYPE_SIMPLE_UNSIGNED_32BIT_VECTOR              0x38
  86. #define TYPE_SIMPLE_VECTOR                             0x40
  87. #define TYPE_SIMPLE_FLOAT_VECTOR                       0x48
  88.  
  89. #define TYPE_SIMPLE_BIT_MULTI_ARRAY                    0x02
  90. #define TYPE_SIMPLE_SIGNED_8BIT_MULTI_ARRAY            0x0a
  91. #define TYPE_SIMPLE_UNSIGNED_8BIT_MULTI_ARRAY          0x12
  92. #define TYPE_SIMPLE_CHAR_MULTI_ARRAY                   0x1a
  93. #define TYPE_SIMPLE_SIGNED_16BIT_MULTI_ARRAY           0x22
  94. #define TYPE_SIMPLE_UNSIGNED_16BIT_MULTI_ARRAY         0x2a
  95. #define TYPE_SIMPLE_SIGNED_32BIT_MULTI_ARRAY           0x32
  96. #define TYPE_SIMPLE_UNSIGNED_32BIT_MULTI_ARRAY         0x3a
  97. #define TYPE_SIMPLE_PTR_MULTI_ARRAY                    0x42
  98. #define TYPE_SIMPLE_FLOAT_MULTI_ARRAY                  0x4a
  99.  
  100.  
  101. #define TYPE_COMPLEX_BIT_VECTOR                        0x04
  102. #define TYPE_COMPLEX_SIGNED_8BIT_VECTOR                0x0c
  103. #define TYPE_COMPLEX_UNSIGNED_8BIT_VECTOR              0x14
  104. #define TYPE_COMPLEX_CHAR_VECTOR                       0x1c
  105. #define TYPE_COMPLEX_SIGNED_16BIT_VECTOR               0x24
  106. #define TYPE_COMPLEX_UNSIGNED_16BIT_VECTOR             0x2c
  107. #define TYPE_COMPLEX_SIGNED_32BIT_VECTOR               0x34
  108. #define TYPE_COMPLEX_UNSIGNED_32BIT_VECTOR             0x3c
  109. #define TYPE_COMPLEX_PTR_VECTOR                        0x44
  110. #define TYPE_COMPLEX_FLOAT_VECTOR                      0x4c
  111.  
  112.  
  113. #define TYPE_COMPLEX_BIT_MULTI_ARRAY                   0x06
  114. #define TYPE_COMPLEX_SIGNED_8BIT_MULTI_ARRAY           0x0e
  115. #define TYPE_COMPLEX_UNSIGNED_8BIT_MULTI_ARRAY         0x16
  116. #define TYPE_COMPLEX_CHAR_MULTI_ARRAY                  0x1e
  117. #define TYPE_COMPLEX_SIGNED_16BIT_MULTI_ARRAY          0x26
  118. #define TYPE_COMPLEX_UNSIGNED_16BIT_MULTI_ARRAY        0x2e
  119. #define TYPE_COMPLEX_SIGNED_32BIT_MULTI_ARRAY          0x36
  120. #define TYPE_COMPLEX_UNSIGNED_32BIT_MULTI_ARRAY        0x3e
  121. #define TYPE_COMPLEX_PTR_MULTI_ARRAY                   0x46
  122. #define TYPE_COMPLEX_FLOAT_MULTI_ARRAY                 0x4e
  123.  
  124.  
  125. #define TYPE_BIGNUM                                    0x01
  126. #define TYPE_RATIO                                     0x09
  127. #define TYPE_FLOAT                                     0x05
  128. #define TYPE_COMPLEX                                   0x0d
  129.  
  130. #define TYPE_SYMBOL                                    0x03
  131. #define TYPE_LINE_SYMBOL                               0x0b
  132.  
  133. #define TYPE_CHARACTER                                 0x07
  134. #define TYPE_CONS                                      0x0f
  135. #define TYPE_OE                                        0x17
  136. #define TYPE_FOREIGN_PTR                               0x1f
  137. #define TYPE_PROCEDURE                                 0x27
  138. #define TYPE_STRUCTURE                                 0x2f
  139. #define TYPE_VOID                                      0x37
  140. #define TYPE_CLOSURE                                   0x3f
  141. #define TYPE_FORWARDING_PTR                            0x47
  142. #define TYPE_UBV                                       0x4f
  143. #define TYPE_END_OF_PAGE                               0x7f
  144.  
  145. #define LP unsigned char *
  146. #define LPL unsigned long *
  147. #define LREF(x) (((LP) &(x)) + 5)    /*  skip header, add tag bit */
  148. #define DEREF(x) *((LPL) ((x) - 1)) /*  adjust for tag, then ref */
  149. #define ADD_TAG(x) ((LP) (x) + 1)
  150. #define REMOVE_TAG(x) ((LP) (x) - 1)
  151. #define LD unsigned long
  152. #define LDREF(ptr,type,field) ((type *) (((LP) ptr) - 5))->field
  153. #define SYMREF(sym,slot) LDREF((LDREF(sym,SYMBOL,self_link)),SYMBOL,slot)
  154. #define NULL 0
  155. #define NIL LREF(s_lsp_NIL)
  156. #define T LREF(s_lsp_T)
  157. #define UBV_MARKER LREF(ubv_marker)
  158. #define UBK_MARKER LREF(ubv_marker)
  159.  
  160. #define MOST_POSITIVE_FIXNUM 1073741823
  161. #define MOST_NEGATIVE_FIXNUM -1073741824
  162. /* HEY! Finish conversions for fx/bignum to signed/unsigned 32/16/8 */
  163. #define FX_TO_INT(fx) ((int) (fx) >> 1)
  164. #define FX_TO_UINT(fx) ((int) (fx) >> 1) /*  HEY! fix this... */
  165. #define INT_TO_FX(i)  ((LP) ((int) (i) << 1))
  166. #define INT32_TO_INTEGER(i) (((((int) (i)) <= MOST_POSITIVE_FIXNUM) && \
  167.                   (((int) (i)) >= MOST_NEGATIVE_FIXNUM)) ? \
  168.                  INT_TO_FX(i) : \
  169.                  int32_to_bignum(i))
  170. #define UINT32_TO_INTEGER(i) ((((unsigned long) (i)) \
  171.                    <= MOST_POSITIVE_FIXNUM) ? \
  172.                  INT_TO_FX(i) : \
  173.                  uint32_to_bignum((unsigned long) (i)))
  174. #define INTEGER_TO_INT32(i) (FIXNUMP(i) ? FX_TO_INT(i) : bignum_to_int32(i))
  175. #define INTEGER_TO_UINT32(i) (FIXNUMP(i) ? FX_TO_UINT(i) : bignum_to_uint32(i))
  176. #define FIXNUMP(x) (((unsigned long) (x) & 1) == 0) 
  177. #define OTHER_PTRP(x) (((unsigned long) (x) & 1) != 0)
  178.  
  179. #define HEADER(obj) ((unsigned long) DEREF((obj) - 4))
  180. #define TAG(obj) ((unsigned char) HEADER(obj))
  181. #define LEN_FIELD(obj) (HEADER(obj) >> 8)
  182. #define PASS_TO_C(obj) (FIXNUMP(obj) ? FX_TO_INT(obj) : \
  183.                         (IMMED_OBJ_P(obj) ? \
  184.             (unsigned long) DEREF(obj) : \
  185.             (unsigned long) (obj - 1)))
  186. #define LISTP(x) (((OTHER_PTRP(x) && (TAG(x) == TYPE_CONS))) || (x == NIL))
  187.  
  188. #define NEW_PROCEDURE alloc_words(1,TYPE_PROCEDURE)
  189. #define NEW_CONS      alloc_words(2,TYPE_CONS)
  190.  
  191. /* Closure allocation. */
  192.  
  193. #define OPEN_PROCEDURE_FLAG 1
  194. #define CLOSED_PROCEDURE_FLAG 1234
  195. #define FUNCALLABLE_INSTANCE_FLAG 5678
  196. #define FUNCALLABLE_INSTANCE_HEADER ((FUNCALLABLE_INSTANCE_FLAG << 8) + \
  197.                      TYPE_PROCEDURE)
  198. #define CLOSED_PROCEDURE_HEADER ((CLOSED_PROCEDURE_FLAG << 8) + \
  199.                  TYPE_PROCEDURE)
  200. #define NEW_OE(len) new_oe(len)
  201. #define GET_OE_SLOT(oe_var,i) (LP) (DEREF(oe_var + i * 4))
  202. #define SET_OE_SLOT(oe_var,i,value) (DEREF(oe_var + i * 4) = (LD) value)
  203. #define MAKE_CLOSURE(code,env) new_closure((LP) code,env)
  204. #define COERCE_TO_FUNCTION(x) p_lsp_COERCE_2DTO_2DFUNCTION(1,x)
  205.  
  206. #ifdef ansi_fixed_args
  207. #define ICALL(sym) ((LP (*)(ARGC dummy, ...)) ((LP) DEREF(sym.function)))
  208. #define CODE_PTR(procedure) ((LP (*)(ARGC dummy, ...)) ((LP) DEREF(procedure)))
  209. #else
  210. #define ICALL(sym) ((LP (*)()) ((LP) DEREF(sym.function)))
  211. #define CODE_PTR(procedure) ((LP (*)()) ((LP) DEREF(procedure)))
  212. #endif
  213.  
  214. /* object layout */
  215.  
  216. typedef struct double_float {
  217.   unsigned long header;
  218.   double number;
  219. } FLOAT;
  220.  
  221. typedef struct ratio {
  222.   unsigned long header;
  223.   LP numerator;
  224.   LP denominator;
  225. } RATIO;
  226.  
  227. typedef struct complex {
  228.   unsigned long header;
  229.   LP real;
  230.   LP imaginary;
  231. } COMPLEX;
  232.  
  233. typedef  struct character  {
  234.   unsigned long header;
  235.   unsigned long char_code;
  236. } CHARACTER;
  237.  
  238. /* The length field of the header holds a number which indicates if this
  239.    procedure is a closure or a funcallable instance. */
  240. typedef struct procedure {
  241.   unsigned long header;
  242.   unsigned char *code_pointer;
  243. } PROCEDURE;
  244.  
  245. typedef struct funcallable_instance {
  246.   unsigned long header;
  247.   unsigned char *code_pointer;
  248.   LP wrapper;
  249.   LP slots;
  250. } FUNCALLABLE_INSTANCE;
  251.  
  252. typedef struct symbol {
  253.   unsigned long header;
  254.   LP value;
  255.   LP package;
  256.   LP self_link;            /* only needed if we use line_symbols */
  257.   LP plist;
  258.   LP function;
  259.   LP hashcode;
  260.   unsigned long flags;
  261.   LP name;
  262. } SYMBOL;
  263.  
  264. /* Experimental line number debugging hack. Probably a loser. */
  265. typedef struct line_symbol {
  266.   unsigned long header;
  267.   LP line;
  268.   LP padding;            /* preserve car/cdr hack */
  269.   LP self_link; 
  270. } LINE_SYMBOL;
  271.  
  272. typedef struct cons {
  273.   unsigned long header;
  274.   LP car;
  275.   LP cdr;
  276. } CONS;
  277.  
  278. typedef struct simple_multi_array {
  279.   unsigned long header;
  280.   LP underlying_vector;
  281.   LP dims_vector;
  282.   LP multiplier_vector;
  283. } SIMPLE_MULTI_ARRAY;
  284.  
  285. typedef struct complex_vector {
  286.   unsigned long header;
  287.   LP underlying_vector;
  288.   LP fill_pointer;
  289.   LP displaced_index_offset;
  290. } COMPLEX_VECTOR;
  291.  
  292. typedef struct complex_multi_array {
  293.   unsigned long header;
  294.   LP underlying_vector;
  295.   LP dims_vector;
  296.   LP multiplier_vector;
  297.   LP displaced_index_offset;
  298. } COMPLEX_MULTI_ARRAY;
  299.  
  300. typedef struct ubv {
  301.   unsigned long header;
  302.   unsigned long pad;
  303. } UBV;
  304.  
  305. typedef struct foreign_pointer {
  306.   unsigned long header;
  307.   LP pointer;
  308.   LP type;
  309. } FOREIGN_POINTER;
  310.  
  311. /* Some losing C preprocessors will only pass 80 chars in a string! */
  312. #define MAKE_SIMPLE_STRING(label,len,str) \
  313.   static struct {unsigned long header; char string[len+1];} \
  314.   label  = {((len << 8) + TYPE_SIMPLE_STRING), str}
  315.  
  316. #define MAKE_SYMBOL(label,value,package,name,plist,function,hashcode,flags) \
  317.   SYMBOL label = {TYPE_SYMBOL, value, package, LREF(label), \
  318.           plist, function, hashcode,flags, name}
  319.  
  320. #define MAKE_FLOAT(label,f) \
  321.   static FLOAT label = {TYPE_FLOAT, f}
  322.  
  323. #define MAKE_RATIO(label,numerator,denominator) \
  324.   static RATIO label = {TYPE_RATIO, numerator, denominator}
  325.  
  326. #define MAKE_COMPLEX(label,real,imag) \
  327.   static COMPLEX label = {TYPE_COMPLEX, real, imag}
  328.  
  329. #define MAKE_CONS(label,car,cdr) \
  330.   static CONS label = {TYPE_CONS,car,cdr}
  331.  
  332. #define MAKE_PROCEDURE(label,code_ptr) \
  333.   static PROCEDURE label = {TYPE_PROCEDURE, (LP) code_ptr}
  334.  
  335. extern SYMBOL s_lsp_NIL;
  336. extern SYMBOL s_lsp_T;
  337. extern CHARACTER char_tab[];
  338.  
  339. #define NEW_FLOAT(expr) new_float((double) expr)
  340. #define NEW_CHAR(expr) ((LP) LREF(char_tab[(int) expr]))
  341. #define NEW_FPTR(type,expr) new_foreign_ptr((LP) type, (LP) expr)
  342.  
  343. /* We need this to cope with the alignment of doubles in structures */
  344. #define RAW_FLOAT(x) (((FLOAT *) ((x) - 5))->number)
  345. #define RAW_CHAR(x) (((CHARACTER *) ((x) - 5))->char_code)
  346. #define RAW_FPTR(x) (((FOREIGN_POINTER *) ((x) - 5))->pointer)
  347.  
  348. /* Arg related stuff */
  349.  
  350. #define ARGC unsigned long
  351. #define CALL_ARG_LIMIT 512
  352. #define MULTIPLE_VALUE_LIMIT 512
  353. #define APPLY_ARGS_LIMIT CALL_ARG_LIMIT    /* but Generic apply only hacks 32 */
  354.  
  355. typedef struct mv {
  356.   ARGC argc;
  357.   int  return_flag;
  358.   LP values[MULTIPLE_VALUE_LIMIT];
  359. } MV;
  360.  
  361. #define MV_HOLDER_P(x) (((unsigned long) x) > 0xffff)
  362.  
  363. #define BEGIN_MV_CALL(mv_holder,real_argc) \
  364.   { MV holder; \
  365.     MV * mv_holder = &holder; \
  366.     mv_holder->argc = real_argc; \
  367.     mv_holder->return_flag = -1
  368.  
  369. #define MV_CALL(mv_holder,real_argc) \
  370.     (MV_HOLDER_P(mv_holder) ? \
  371.      (((MV *) mv_holder)->argc = real_argc, (ARGC) mv_holder) : real_argc)
  372.  
  373. #define SET_MV_RETURN_FLAG(mv_holder) ((MV *)mv_holder)->return_flag = 1
  374.  
  375. #define SET_MV_RETURN_COUNT(mv_holder,count) ((MV *)mv_holder)->argc = count
  376.  
  377. #define SET_MV_RETURN_VALUE(mv_holder,i,value) \
  378.       ((MV *)mv_holder)->values[i] = value
  379.  
  380. #define GET_MV_RETURN_COUNT(mv_holder) ((MV *)mv_holder)->argc
  381.  
  382. #define MV_RETURN_P(mv_holder) (mv_holder->return_flag != -1)
  383.  
  384. #define SV_RETURN_P(mv_holder) (mv_holder->return_flag == -1)
  385.  
  386. #define END_MV_CALL \
  387.   }
  388.  
  389. #define REAL_ARGC(mv_holder) \
  390.   (MV_HOLDER_P(mv_holder) ? \
  391.    ((MV *) mv_holder)->argc : mv_holder)
  392.  
  393. #define BEGIN_NON_ANSI_VAR_ARGS \
  394.   { va_list ap; \
  395.     va_start(ap)
  396.  
  397. #define BEGIN_ANSI_VAR_ARGS(last_required) \
  398.   { va_list ap; \
  399.     va_start(ap,last_required)
  400.  
  401. #define NEXT_VAR_ARG va_arg(ap,LP)
  402.  
  403. #define END_VAR_ARGS \
  404.   va_end(ap); \
  405.   }
  406.  
  407. #define BEGIN_VAR_VALUES \
  408.   { int index = 0        /*  don't confilict with next in RESTIFY! */
  409.     
  410. #define NEXT_VAR_VALUE(mv_holder) mv_holder->values[index++]
  411.  
  412. #define END_VAR_VALUES \
  413.   }
  414.  
  415. #define DYNAMIC_REST_HOLDER(var) CONS var[CALL_ARG_LIMIT]
  416.  
  417. #define RESTV_HOLDER(var)  LP var[CALL_ARG_LIMIT + 1]
  418.  
  419. #define RESTIFY(rest_var,start_from,next_arg_func) \
  420.     { ARGC start; LP tail = NIL; LP next;  \
  421.       rest_var = NIL; \
  422.       if (real_argc > CALL_ARG_LIMIT) arg_limit_exceeded(real_argc); \
  423.       for (start = start_from; start <= real_argc; start++) { \
  424.     next = NEW_CONS; \
  425.     LDREF(next,CONS,car) = next_arg_func; \
  426.     if (tail != NIL) LDREF(tail,CONS,cdr) = next; \
  427.     if (rest_var == NIL) rest_var = next; \
  428.     tail = next; \
  429.       } \
  430.       if (tail != NIL) LDREF(tail,CONS,cdr) = NIL; \
  431.     }
  432.  
  433. #define DYNAMIC_RESTIFY(rest_var,start_from,next_arg_func) \
  434.     { int len = (real_argc - start_from + 1); int i = 0; \
  435.       if (len > CALL_ARG_LIMIT) arg_limit_exceeded(len); \
  436.       if (len <= 0) { \
  437.     rest_var = NIL; \
  438.       } else { \
  439.     while (i < len) { \
  440.      rest_conses[i].header = TYPE_CONS; \
  441.      rest_conses[i].car = next_arg_func; \
  442.          rest_conses[i].cdr = ((LP) &(rest_conses[i + 1].car)) + 1; \
  443.      i = i + 1; \
  444.         } \
  445.         rest_conses[i - 1].cdr = NIL; \
  446.         rest_var = ((LP) &(rest_conses[0].car)) + 1; \
  447.       } \
  448.     }
  449.  
  450. #define RESTVIFY(restv_var,start_from,next_arg_func) \
  451.     { int len = (real_argc - start_from + 1); int i; \
  452.       if (len > CALL_ARG_LIMIT) arg_limit_exceeded(len); \
  453.     restv_vector[0] = (LP) (TYPE_SIMPLE_VECTOR + (len << 8)); \
  454.     for (i = 1; i <= len; i++) restv_vector[i] =  next_arg_func; \
  455.     restv_var = ((LP) &(restv_vector[1])) + 1; \
  456.     }
  457.  
  458. #define BEGIN_KEY_INIT(var,keyword,rest) \
  459.  if ((var = lookup_keyword(keyword,rest)) == UBK_MARKER) {    
  460.  
  461. #define END_KEY_INIT }
  462.  
  463. /* DYNAMIC unwind/protect stuff */
  464.  
  465. #include <setjmp.h> 
  466.  
  467. #define UW_CATCH        0
  468. #define UW_PROTECT      1
  469. #define UW_SPECBIND     2
  470. #define UW_DYNAMIC_TAG  3
  471.  
  472. /* We could have different types  (CATCH, SPECBIND, PROTECT) of structures
  473.    rather than one. Perhaps it's worth changing one day... */
  474. typedef struct uw_point {
  475.   struct uw_point *next;
  476.   char type;
  477.   MV *mv_holder;        /* for mv catch */
  478.   jmp_buf c_env;
  479.   struct uw_point *continue_dest;
  480.   LP name;
  481.   LP value;
  482. } UW_POINT;
  483.  
  484. extern UW_POINT *uw_top;
  485.  
  486. #define POP_UW_POINT uw_top = uw_top->next
  487.  
  488. #define PUSH_UW_POINT(new) new.next = uw_top; uw_top = &new 
  489.  
  490. #define BEGIN_CATCH(tag,values_holder) \
  491.     { UW_POINT uwp; \
  492.       LP catch_tmp; \
  493.       uwp.type = UW_CATCH; \
  494.       uwp.name = tag;  \
  495.       uwp.mv_holder = (MV *) values_holder; \
  496.       if  ((catch_tmp = (LP) setjmp(uwp.c_env)) == 0) { \
  497.           PUSH_UW_POINT(uwp);
  498.  
  499. /* HEY! Setjmp converts 0 to 1! Have to convert back explicitly */
  500. #define END_CATCH(value_var) \
  501.       } else value_var = (catch_tmp == 1 ? 0 : catch_tmp); \
  502.     POP_UW_POINT; \
  503.     } 
  504.  
  505. #define BEGIN_SPEC_BIND(symbol,new_value) \
  506.   { UW_POINT uwp; \
  507.     uwp.type = UW_SPECBIND; \
  508.     uwp.name = LREF(symbol); \
  509.     uwp.value = symbol.value; \
  510.     PUSH_UW_POINT(uwp); \
  511.     symbol.value = new_value;
  512.  
  513. #define END_SPEC_BIND(symbol) \
  514.     symbol.value = uwp.value; \
  515.     POP_UW_POINT; \
  516.   }
  517.  
  518. #define BEGIN_UW_PROTECT_BODY \
  519.   { UW_POINT uwp; \
  520.     int flag; \
  521.     uwp.type = UW_PROTECT; \
  522.     if  ((flag = setjmp(uwp.c_env)) == 0) { \
  523.       PUSH_UW_POINT(uwp); \
  524.  
  525. #define  BEGIN_UW_PROTECT_CLEANUP \
  526.     }
  527.  
  528. /* HEY! Shouldn't we do the pop before begining the cleanup form? */
  529. #define CONTINUE_FROM_PROTECT \
  530.       POP_UW_POINT; \
  531.       if (flag != 0) unwind(uwp.continue_dest,uwp.value); \
  532.   }
  533.  
  534. #define THROW(tag,value,mv_holder) throw(tag,value,mv_holder)
  535.  
  536. #define BEGIN_DYNAMIC_TAG(tag,label) \
  537.     { UW_POINT uwp; int flag; \
  538.       uwp.type = UW_DYNAMIC_TAG; \
  539.       uwp.name = tag;  \
  540.       if  ((flag = setjmp(uwp.c_env)) != 0) \
  541.     goto label; else PUSH_UW_POINT(uwp);
  542.       
  543. #define END_DYNAMIC_TAG \
  544.     POP_UW_POINT; \
  545.     } 
  546.  
  547. #define GOTO_DYNAMIC_TAG(tag) dynamic_go(tag)
  548.  
  549. /* These symbol macros are only used by the linker and do not need
  550.    to indirect through the symbol link. */
  551. #define UPDATE_VAR(sym,v,flag_pos) sym.value = (LP) v; \
  552.                                    SET_SYMBOL_FLAG(sym,flag_pos)
  553.     
  554. #define UPDATE_FUNC(sym,value) sym.function = LREF(value)
  555.  
  556. /* HEY! This is broken, need to put func in hash table */    
  557. #define UPDATE_MACRO(sym,value,flag_pos) UPDATE_FUNC(sym,value); \
  558.                                          SET_SYMBOL_FLAG(sym,flag_pos)
  559.       
  560. extern PROCEDURE ubf_procedure;
  561. extern UBV ubv_marker;
  562. extern LP OE;
  563. extern LP p_lsp_APPLY PROTO((ARGC argc, LP procedure, ...));
  564. extern LP p_lsp_FUNCALL PROTO((ARGC argc, LP procedure, ...));
  565. extern LP alloc_memory PROTO((int len, int word_size, int type));
  566. extern LP alloc_doubles PROTO((int len, int tag));
  567. extern LP alloc_words PROTO((int len, int tag));
  568. extern LP alloc_shorts PROTO((int size, int tag));
  569. extern LP alloc_bytes PROTO((int len, int tag));
  570. extern LP alloc_bits PROTO((int len, int tag));
  571. extern LP new_closure PROTO((LP code ,LP env));
  572. extern LP new_oe PROTO((int len));
  573. extern LP new_float PROTO((double n));
  574. extern LP new_foreign_ptr PROTO((LP type, LP ptr));
  575. extern void lisp_debug PROTO(());
  576. extern LP lookup_keyword PROTO((LP kwd,LP l));
  577. extern double float_significand PROTO((double f));
  578. extern double bignum_to_double PROTO((LP x));
  579. extern LP int32_to_bignum PROTO((int i));
  580. extern LP uint32_to_bignum PROTO((unsigned long i));
  581. extern int bignum_to_int32 PROTO((LP b));
  582. extern LP c_to_lisp_vector PROTO((char* vector,
  583.                   int element_type_tag, int len));
  584.  
  585.